perm filename XXX.B[C,JRA] blob
sn#021221 filedate 1973-01-19 generic text, type T, neo UTF8
00100 (DEFPROP MATCH T *LSUBR)(DEFPROP PATTERN T *SUBR)
00125
00137
00150 (DEFPROP CSET T *LSUBR)
00200
00250 (SPECIAL PATTERN ALISTS *ITEMS)
00300 (DEFPROP FETCHI1
00400 (LAMBDA(PATTERN CON)
00500 (PROG (ALISTS)
00600 (RETURN
00700 (MAPCAN (FUNCTION
00800 (LAMBDA(ITEM)
00900 (COND
01000 ((SETQ ALISTS (MATCH PATTERN (CAR ITEM))) (LIST (LIST (QUOTE *ITEM) ITEM (CAR ALISTS)))))))
01100 (SEARCH *ITEMS PATTERN T (CDR CON))))))
01200 EXPR)
01300
01400 (DEFPROP FETCHM1
01500 (LAMBDA(PATTERN INDEX CON)
01600 (MAPCAN (FUNCTION
01700 (LAMBDA(METHOD)
01800 ((LAMBDA(MRESULT)
01900 (COND (MRESULT (LIST (CONS (QUOTE *METHOD) (CONS METHOD (NCONC MRESULT (LIST PATTERN))))))))
02000 (MATCH (PATTERN METHOD) PATTERN))))
02100 (SEARCH INDEX PATTERN NIL (CDR CON))))
02200 EXPR)
02300
02350 (SPECIAL CON)(UNSPECIAL PATTERN ALISTS *ITEMS)
02400 (DEFPROP SEARCH
02500 (LAMBDA(INDEX PATTERN ITEM CON)
02600 (MAPCAN (FUNCTION (LAMBDA (THING) (COND ((REALITY1 (CDR (CMARKERS THING)) CON) (LIST THING)))))
02700 (ISEARCH INDEX PATTERN ITEM)))
02800 EXPR)
02900
05700
05750 (SPECIAL ALIST TEM)(DEFPROP ACCESS T *LSUBR)
05800 (DEFPROP SETUP
05900 (LAMBDA (ALIST)(PROG2 (SETQ TEM (ACCESS)) (MAPC (FUNCTION (LAMBDA (PAIR) (CSET (CAR PAIR) (CADR PAIR) TEM))) ALIST)) )
06000 EXPR)
06100
06150 (DEFPROP VLOC T *LSUBR)(SPECIAL L)(DEFPROP /, T *FSUBR)
06200 (DEFPROP PROPOSE
06300 (LAMBDA(L)(PROG2
06400 (SETQ L (CDR (VLOC (QUOTE NEXT))))
06500 (MAPC (FUNCTION (LAMBDA (X)(PROG2 (RPLACD (CAR L) (CONS X (CDAR L))) (RPLACA L (CDAR L))))) (/, L))) )
06600 FEXPR)